home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / GETCPRV.FOR < prev    next >
Text File  |  1988-02-08  |  4KB  |  140 lines
  1.       SUBROUTINE GETCPRV ( N, PRIV )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          GETCPRV          **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          GET CURRENT PRIVILEGES
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CA  94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          TO CHECK THE PRIVILEGES CURRENTLY ACTIVE FOR THE PROCESS.
  23. C*
  24. C*     INPUT ARGUMENTS :
  25. C*          NONE
  26. C*
  27. C*     OUTPUT ARGUMENTS :
  28. C*          N     - THE NUMBER OF PRIVILEGES FOUND
  29. C*          PRIV  - THE ARRAY CONTAINING THE NAMES OF THE PRIVILEGES
  30. C*
  31. C*     INTERNAL WORK AREAS :
  32. C*          MASK1, MASK2 - THE MASK BITS FOR THE PRIVILEGES
  33. C*          ALL1, ALL2 - THE ASCII NAMES CORRESPONDING TO MASK1 AND MASK2
  34. C*
  35. C*     COMMON BLOCKS :
  36. C*          NONE
  37. C*
  38. C*     FILE REFERENCES :
  39. C*          NONE
  40. C*
  41. C*     SUBPROGRAM REFERENCES :
  42. C*          JPI$_AUTHPRIV,  JPI$_CURPRIV, SYS$GETJPIW
  43. C*
  44. C*     ERROR PROCESSING :
  45. C*          NONE
  46. C*
  47. C*     TRANSPORTABILITY LIMITATIONS :
  48. C*          ABSOLUTELY NOT TRANSPORTABLE
  49. C*
  50. C*     ASSUMPTIONS AND RESTRICTIONS :
  51. C*          NONE
  52. C*
  53. C*     LANGUAGE AND COMPILER :
  54. C*          ANSI FORTRAN 77
  55. C*
  56. C*     VERSION AND DATE :
  57. C*          VERSION I.0     12-APR-85
  58. C*
  59. C*     CHANGE HISTORY :
  60. C*          12-APR-85    INITIAL VERSION
  61. C*
  62. C***********************************************************************
  63. C*
  64.       CHARACTER *(*) PRIV(1)
  65.       CHARACTER *10 ALL1(32), ALL2(7)
  66.       INTEGER *2 ITEM(2)
  67.       INTEGER *4 MASK1(32), MASK2(7), ITMLST(3), QUAD(2)
  68.       EQUIVALENCE (ITEM(1),ITMLST(1))
  69. C
  70. C --- ITEM CODES
  71. C
  72.       EXTERNAL JPI$_AUTHPRIV,   JPI$_CURPRIV
  73. C
  74. C --- PRIVILEGE NAMES IN THE FIRST QUADWORD
  75. C
  76.       DATA ALL1 /     'ACNT      ', 'ALLSPOOL  ', 'BUGCHK    ',
  77.      $  'BYPASS    ', 'CMEXEC    ', 'CMKRNL    ', 'DETACH    ',
  78.      $  'DIAGNOSE  ', 'EXQUOTA   ', 'GROUP     ', 'GRPNAM    ',
  79.      $  'LOG_IO    ', 'MOUNT     ', 'NETMBX    ', 'OPER      ',
  80.      $  'PFNMAP    ', 'PHY_IO    ', 'PRMCEB    ', 'PRMGBL    ',
  81.      $  'PRMMBX    ', 'PSWAPM    ', 'SETPRI    ', 'SETPRV    ',
  82.      $  'SHARE     ', 'SHMEM     ', 'SYSGBL    ', 'SYSLCK    ',
  83.      $  'SYSNAM    ', 'SYSPRV    ', 'TMPMBX    ', 'VOLPRO    ',
  84.      $  'WORLD     '/
  85. C
  86. C --- PRIVILEGE NAMES IN THE SECOND QUAD WORD
  87. C
  88.       DATA ALL2 /     'DOWNGRADE ', 'GRPPRV    ', 'PRMJNL    ',
  89.      $  'READALL   ', 'SECURITY  ', 'TMPJNL    ', 'UPGRADE   '/
  90. C
  91. C --- MASK BITS FOR THE FIRST QUAD WORD
  92. C
  93.       DATA MASK1 /     512,          16,           8388608,
  94.      $   536870912,    2,            1,            32,
  95.      $   64,           524288,       256,          8,
  96.      $   128,          131072,       1048576,      262144,
  97.      $   67108864,     4194304,      1024,         16777216,
  98.      $   2048,         4096,         8192,         16384,
  99.      $   -2147483648,  134217728,    33554432,     1073741824,
  100.      $   4,            268435456,    32768,        2097152,
  101.      $   65536 /
  102. C
  103. C --- MASK BITS FOR THE SECOND QUAD WORD
  104. C
  105.       DATA MASK2 /     2,            4,            32,
  106.      $   8,            64,           16,           1 /
  107. C
  108.       N = 0
  109. C
  110. C --- FILL ITMLST
  111. C
  112.       ITEM(1)   = 8
  113.       ITEM(2)   = %LOC( JPI$_CURPRIV )
  114.       ITMLST(2) = %LOC( QUAD(1) )
  115.       ITMLST(3) = %LOC( LENG )
  116.       ISTAT = SYS$GETJPIW ( ,,, ITMLST, IOSB,, )
  117. C
  118. C --- PROCESS FIRST WORD OF QUAD WORD
  119. C
  120.       DO 10 I = 1,32
  121.          IF ((QUAD(1) .AND. MASK1(I)) .NE. 0) THEN
  122.             N = N + 1
  123.             PRIV(N) = ALL1(I)
  124.          ENDIF
  125. 10       CONTINUE
  126. C
  127. C --- PROCESS SECOND WORD OF QUAD WORD
  128. C
  129.       DO 20 I = 1,7
  130.          IF ((QUAD(2) .AND. MASK2(I)) .NE. 0) THEN
  131.             N = N + 1
  132.             PRIV(N) = ALL2(I)
  133.          ENDIF
  134. 20       CONTINUE
  135.       RETURN
  136.       END
  137. C
  138. C---END GETCPRV
  139. C
  140.